perm filename VIXSUB.FAI[VIS,HPM]1 blob sn#139782 filedate 1975-01-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	VIXSUB
C00007 00003	******************** SAIL INTERFACE ***********************
C00010 ENDMK
C⊗;
	TITLE	VIXSUB
	EXTERN	XL,YH,XSC,YSC
	EXTERN	SLINE,DBUF,BSK,SCRTCH
	ENTRY	VIDEO,HAFTON

ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
DX←10 ↔ DY←11 ↔ PICX←12 ↔ PICY←13 ↔ XBIT←14 ↔ XPIC←15 ↔ YPIC←16 ↔ T←17

GRYUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF
	MOVE	T,COLTAB
	HRRM	T,CTF
	HRRM	BT,TI
	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOK			;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOK:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOK
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOK:	CAIL	X2,21*40
	MOVEI	X2,21*40
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@GRYUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLP:	HLRZ	YPIC,PICY
RTF:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLP

XLP:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJ
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	MOVE	YPIC,SLINE(YA)
TI:	TRNE	T,BT			;REPLACED BY ACTUAL MASK
TJ:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLP

	ADD	PICX,DX
	AOBJN	X1,XLP
	JRST	@GRYUP



TONUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF1
	MOVE	T,COLTAB
	HRRM	T,CTF1
	MOVN	BT,PICBIT
	SUBI	BT,1
	HRRM	BT,TIH
	MOVEI	BT,737373
	CAML	X1,X2			;PUT UP THE
	EXCH	X1,X2			;PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2			;AS A RANDOM DOT PATTERN
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOKH		;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOKH:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOKH
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOKH:	CAIL	X2,21*40
	MOVEI	X2,21*40
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@TONUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLPH:	HLRZ	YPIC,PICY
RTF1:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLPH

XLPH:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJH
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF1:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLPH:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
TIH:	ROT	T,-5			;REPLACED BY -PICBIT-1
	MOVE	YPIC,SLINE(YA)
        IMULI	BT,400003
	CAMLE	T,BT			;REPLACED BY ACTUAL MASK
TJH:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLPH

	ADD	PICX,DX
	AOBJN	X1,XLPH
	JRST	@TONUP



;******************** SAIL INTERFACE ***********************
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BPTAB←←12
LINTAB←←13

PICWID:	0
PICLIN:	0
PICHIG:	0
PICBIT:	0
PICWIZ:	0
PICSIZ:	0
COLTAB:	0
ROWTAB:	0

SETUP:	0
	MOVE	T,PCWD(ARRY)		;SET "GLOBALS" FOR COMPATABILITY WITH
	MOVEM	T,PICSIZ		;OLD FORMAT
	MOVE	T,LNBYA(ARRY)
	MOVEM	T,PICWIZ
	MOVE	T,BYBI(ARRY)
	MOVEM	T,PICBIT
	MOVE	T,PCLN(ARRY)
	MOVEM	T,PICHIG
	MOVE	T,LNWD(ARRY)
	MOVEM	T,PICLIN
	MOVE	T,LNBY(ARRY)
	MOVEM	T,PICWID
	MOVE	T,BPTAB(ARRY)
	MOVEM	T,COLTAB
	MOVEI	T,LINTAB(ARRY)
	MOVEM	T,ROWTAB
	MOVE	ARRY,(T)
	JRST	@SETUP


	P←17

	DEFINE	FLOAT(N)
<	TLC	N,232000
	FADR	N,N	>

	OPDEF	FIX[247000233000]

	DEFINE	SAVAC(N)
<	IFGE	N-12,{MOVEM 12,ACS12}
	IFGE	N-16,{MOVEM 16,ACS16}
	IFGE	N-17,{MOVEM 17,ACS17}	>


	DEFINE	RESAC(N)
<	IFGE	N-12,{MOVE 12,ACS12}
	IFGE	N-16,{MOVE 16,ACS16}
	IFGE	N-17,{MOVE 17,ACS17}	>

RETAD:	0
ACS12:	0
ACS16:	0
ACS17:	0

VIDEO:	POP	P,RETAD		;PUT UP BITS BT (A MASK, USUALLY ONLY ONE BIT
	POP	P,BT		;IS ON, IF MULTIPLE BITS ARE ON, THEY ARE OR'D)
	POP	P,ARRY		;OF PICTURE PIC INTO DD RECTANGLE X1-X2,Y1-Y2
	POP	P,Y2		; VIDEO(X1,Y1,X2,Y2,PIC,BT)
	FSBR	Y2,YH
	FMPR	Y2,YSC
	FIX	Y2,
	POP	P,X2
	FSBR	X2,XL
	FMPR	X2,XSC
	FIX	X2,
	POP	P,Y1
	FSBR	Y1,YH
	FMPR	Y1,YSC
	FIX	Y1,
	POP	P,X1
	FSBR	X1,XL
	FMPR	X1,XSC
	FIX	X1,
	SAVAC(17)
	JSR	SETUP
	JSR	GRYUP
	RESAC(17)
	JRST	@RETAD

HAFTON:	POP	P,RETAD		;PUT UP A RANDOM DOT REPRESENTATION
	POP	P,ARRY		;OF PICTURE PIC INTO DD RECTANGLE X1-X2,Y1-Y2
	POP	P,Y2		; HAFTON(X1,Y1,X2,Y2,PIC)
	FSBR	Y2,YH
	FMPR	Y2,YSC
	FIX	Y2,
	POP	P,X2
	FSBR	X2,XL
	FMPR	X2,XSC
	FIX	X2,
	POP	P,Y1
	FSBR	Y1,YH
	FMPR	Y1,YSC
	FIX	Y1,
	POP	P,X1
	FSBR	X1,XL
	FMPR	X1,XSC
	FIX	X1,
	SAVAC(17)
	JSR	SETUP
	JSR	TONUP
	RESAC(17)
	JRST	@RETAD

	END